home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / a / a_funk / antennen.tos / ANTENNEN / YAGI_ON4.BAS < prev   
Encoding:
BASIC Source File  |  1996-10-30  |  18.5 KB  |  659 lines
  1. bbs> Msg# 113921   To: ATARI @EU   From: ON4ASX   Date: 01Mar91/0459
  2. Subject: YAGI BAS prg 1/5
  3. Bulletin ID: 4687_ON4ASX
  4. Path: DB0CZ!OE9XPI!HB9EAS!DB0GE!LX0PAC!ONN7RC!ON4HU!ON4ASX
  5. From: ON4ASX@ON4ASX.BVWV.BEL.EU
  6. To : ATARI@EU
  7. part 1/5
  8.  
  9. LIBRARY "BIOS"
  10.  
  11. maxels=100
  12. dim s(maxels), d(maxels), dh(maxels), dl(maxels),t(maxels)
  13.  
  14. ' ********* TITLE *********
  15. BEGIN:
  16. cls
  17. call revideo(1)
  18. call printat(1,23,"  DL6WU YAGI ANTENNA DESIGN  ",0)
  19. call revideo(0)
  20. call printat(2,24,"Original by  KY4Z and W6NBI",0)
  21. call printat(3,25,"Ported to the ST by G6ATW",0)
  22. ' ********* CALL SIGN **********
  23. MYCALL:
  24. call printat(8,24,"Please Enter Your Call Sign",0)
  25. locate 12,34,1
  26. input "",sign$ : sign$=ucase$(sign$)
  27. if len(sign$) > 10 then goto MYCALL
  28. ' ********* FREQUENCY **********
  29. call clearit
  30. call printat(8,24,"Enter Design Frequency [MHz]",0)
  31. locate 12,34,1
  32. input "",freq$
  33. f=val(freq$)
  34. cm=29979.3/f : inch=11802.9/f
  35. ' ********* DIMENSIONS **********
  36. call clearit
  37. call printat(8,20,"Physical Dimensions Can Be Entered In",0)
  38. call printat(10,29,"[ 1 ] Feet",0)
  39. call printat(11,29,"[ 2 ] Metres",0)
  40. call printat(12,29,"[ 3 ] Wavelengths",0)
  41. call printat(14,29,"Select 1, 2 or 3",0)
  42. do
  43.         p$=inkey$
  44.         select case p$
  45.                 case = "1"
  46.                         u$="Feet" : exit loop
  47.                 case = "2"
  48.                         u$="Metres" : exit loop
  49.                 case = "3"
  50.                         u$="Wavelengths" : exit loop
  51.         end select
  52. loop
  53.  
  54. ' ********** GAIN or BOOM LENGTH ***********
  55. L320:
  56. call clearit
  57. call printat(8,32,"You Can Either",0)
  58. call printat(10,20,"[ 1 ] Specify forward gain in dBd and",0)
  59. call printat(11,20,"      accept estimated boom length, or",0)
  60. call printat(12,20,"[ 2 ] Specify boom length and accept",0)
  61. call printat(13,20,"      estimated gain",0)
  62. call printat(15,32,"Select 1 or 2",0)
  63. do
  64.         kb$=inkey$
  65. loop until kb$="1" or kb$="2"
  66.  
  67. if kb$="2" goto L530
  68.  
  69. ' ********** GAIN *********
  70. L390:
  71. g=0 : prat = 0
  72. while (g<11.8 or g>21.6)
  73.         prat=prat+1
  74.         if prat > 3 then
  75.                call dickhead
  76.         end if
  77.         call clearit
  78.         call printat(8,24,"Forward Gain Must Be Between",0)
  79.         call printat(9,24,"    11.8 dBd and 21.6 dBd",0)
  80.         call printat(11,24,"  Enter Required Gain [dBd]",0)
  81.         locate 13,36,1
  82.         input "",gain$
  83.         g=val(gain$)
  84. wend
  85.  
  86. bl = exp((g-9.2)/3.39)
  87. b1 = bl * inch/12
  88. b2 = bl * cm/100
  89.  
  90. call clearit
  91. call printat(8,24,"Estimated Overall Boom Length",0)
  92. locate 10,34,0
  93. print using "###.##";b1; : print " Feet";
  94. call printat(12,20,"[ ",0)
  95. print using "###.##"; b2; : print " Metres";
  96. print using "###.##"; bl; : print " Wavelengths   ]";
  97. call printat(15,24,"Is This Boom Length Ok ?  Y/N",0)
  98. do
  99.         kb$=ucase$(inkey$)
  100. loop until kb$="Y" or kb$="N"
  101. if kb$="Y" then
  102.         goto L660
  103. else
  104.         goto L320
  105. end if
  106.  
  107. L530:
  108. ' ********* BOOM LENGTH **********
  109. bl = 0 : prat = 0
  110. while (bl<2.2 or bl>39)
  111.         prat = prat+1
  112.         if prat>3 then call dickhead
  113.         call clearit
  114.         call printat(8,20,"Overall Boom Length Must Be Between",0)
  115.         call printat(9,28,"2.2 and 39 Wavelengths",0)
  116.         b1 = 2.2 * cm/100 : b2 = 39 * cm/100
  117.         b3 = 2.2 * inch/12 : b4= 39 * inch/12
  118.         call printat(11,25,"[ ",0)
  119.         print using "###.##"; b1; : print " to ";
  120.         print using  "###.##"; b2; : print " Metres ]";
  121.         call printat(12,25,"[ ",0)
  122.         print using "###.##"; b3; : print " to ";
  123.         print using "###.##"; b4; : print " Feet   ]";
  124.         call printat(114,25,"Enter Boom Length in ",0) : print u$;
  125.         locate 16,36,1
  126.         input "",boom$
  127.         bl=val(boom$)
  128.         if p$="1" then bl = bl * 12 / inch
  129.         if p$="2" then bl = bl * 100 / cm
  130. wend
  131.  
  132. end 1/5
  133.  
  134.  
  135.  
  136. bbs> Msg# 113922   To: ATARI @EU   From: ON4ASX   Date: 01Mar91/0504
  137. Subject: YAGI BAS 2/5
  138. Bulletin ID: 4688_ON4ASX
  139. Path: DB0CZ!OE9XPI!HB9EAS!DB0GE!LX0PAC!ON7RC!ON4HU!ON4ASX
  140. From: ON4ASX@ON4ASX.BVWV.BEL.EU
  141. To  : ATARI@EU
  142.  
  143. 2/5
  144.  
  145. g = 9.2 + 3.39 * log(bl)
  146.  
  147. call printat(18,20,"Estimated Maximum Gain is",0)
  148. print using "###.##";g; : print " dBd";
  149. call printat(20,26,"Is This Gain Ok ?  Y/N",0)
  150. do
  151.         kb$=ucase$(inkey$)
  152. loop until kb$="Y" or kb$="N"
  153. if kb$="N" then goto L320
  154.  
  155. ' ********* BOOM MATERIAL AND ELEMENT MOUNTING ************
  156. L660:
  157. call clearit
  158. call printat(8,18,"Select Boom Material and Element Mounting",0)
  159. call printat(10,18,"[ 1 ] Metal boom,  elements pass through",0)
  160. call printat(11,18,"      and are NOT INSULATED",0)
  161. call printat(12,18,"[ 2 ] Metal boom,  elements pass through",0)
  162. call printat(13,18,"      but are INSULATED",0)
  163. cal printat(14,18,"[ 3 ] Non-metallic boom, or elements are",0)
  164. call printat(15,18,"      mounted on insulators",0)
  165. call printat(17,18,"WARNING: option 3 implies NO CORRECTION",0)
  166. call printat(18,18,"         for influence of metal boom !",0)
  167. call printat(19,18,"         If in doubt, choose 1 or 2",0)
  168. call printat(21,27,"Select 1, 2 or 3",0)
  169. do
  170.         e$=inkey$
  171. loop until e$="1" or e$="2" or e$="3"
  172. if e$="3" then
  173.         bc1 = 0 : bd = 0 : goto L1070
  174. ennd if
  175.  
  176. L780:
  177. bd = -1
  178. while (bd < 0 or bd > 0.06)
  179.          call clearit
  180.         call printat(8,24,"Enter Boom Diameter or Width",0)
  181.         call printat(9,24,"of Square Section in ",0)
  182.         if p$"1" then print "Inches";
  183.         if p$="2" then print "Centimetres";
  184.         d1 = 0.06 * cm : d2 = 0.06 * inch
  185.         call printat(11,18,"[ Maximum ",0)
  186.         print using "##.##"; d1; : print " Centimetres";
  187.         print using "##.##"; d2; : print " Inches ]";
  188.         locate 13,36,1 : input "",boomd$
  189.         bd=val(boomd$)
  190.         if p$="1" then bd = bd / inch
  191.         if p$="2" thhen bd = bd / cm
  192. wend
  193.  
  194. bc1 = 733 * bd * (0.055 - bd) - 504 * bd * (0.03 - bd)
  195. call clearit
  196. call printat(8,18,"Your choice of boom material and element",0)
  197. call printat(9,18,"mounting method requires a correction to",0)
  198. call printat(10,18,"all the element lengths. If the elemments",0)
  199. call printat(11,18,"pass diametrically through the boom, and",0)
  200. call printat(12,18,"are  bonded to  it, the boom  correction",0)
  201. call printat(13,18,"would be ",0)
  202. print using "#.####";bc1; : print " of the boom diameter.";
  203. if e$="1" then
  204.          goto L950
  205. else
  206.         bc1 = bc1 / 2
  207. end if
  208. call printat(14,18,"Since you have chosen insulated elements",0)
  209. call printat(15,18,"the boom correction is one-half that, ie",0)
  210. locate 16,18,0 : print using "#.####"; bc1;
  211. print " of the boom diameter.";
  212. L950:
  213. call printat(18,20,"Is This Boom Correction Ok ?  Y/N",0)
  214. do
  215.         kb$=ucase$(inkey$)
  216. loop until kb$="Y" or kb$="N"
  217. if kb$="Y" then goto L1070
  218.  
  219. call clearit
  220. call printat(8,20,"  Hmmm .... in that case you can",0)
  221. call printat(10,20,"[ 1 ] Enter your own boom correction",0)
  222. call printat(11,20,"[ 2 ] Select a different element",0)
  223. call printat(12,20,"      mounting method",0)
  224. call printat(13,20,"[  3 ] Accept my boom correction",0)
  225. call printat(14,20,"      after all",0)
  226. call printat(15,20,"      Select 1, 2 or 3",0)
  227. do
  228.         kb$=ucase$(inkey$)
  229. loop until kb$="1" or kb$="2" or kb$="3"
  230. if kb$="2" then goto L660
  231. if kb$="3" then goto L1070
  232.  
  233. end 2/5
  234.  
  235.  
  236.  
  237. bbs> Msg# 113924   To: ATARI @EU   From: ON4ASX   Date: 01Mar91/0508
  238. Subject: YAGI BAS 3/5
  239. Bulletin ID: 4689_ON4ASX
  240. Path: DB0CZ!OE9XPI!HB9EAS!DB0GE!LX0PAC!ON7RC!ON4HU!ON4ASX
  241. From: ON4ASX@ON4ASX.BVWV.BEL.EU
  242. To  : ATARI@EU
  243.  
  244. 3/5
  245.  
  246. bc1= -1
  247. while (bc1<0 or bc1>1)
  248.         call clearit
  249.         call printat(8,20,"Enter your correction as a fraction",0)
  250.         call printat(9,20,"of boom  diameter  between  0 and 1",0)
  251.         locate 11,36,1 : input "", bcor$
  252.         bc1 = val(bcor$)
  253. wend
  254.  
  255. bc = bc1 * bd
  256.  
  257. ' ********* ELEMENT DIAMETERS *************
  258. L1070:
  259. dd = -1 : ed = -1
  260. while (dd < 0.001 or dd > 0.02 or ed < 0.001 or ed > 0.02)
  261.         call clearit
  262.         call printat(8,22,"Element Diameter Must Be Between",0)
  263.         call printat(9,22,"   0.001 and 0.02 Wavelengths",0)
  264.         d1 = 0.001 * cm : d2 = 0.02 * cm
  265.         d3 = 0.001 * inch : d4 = 0.02 * inch
  266.         call printat(11,23,"[ ",0)
  267.         print using "##.##"; d1; : print " to ";
  268.         print using "##.##"; d2; : print " Centimetres ]";
  269.         call printat(12,23,"[ ",0)
  270.         print using "##.##"; d3; : print " to ";
  271.         print using "##.##"; d4; : print " Inches      ]";
  272.         call printat(14,24,"Enter Driven Element Diameter",0)
  273.         locate 15,32,0 : print "in ";
  274.         if p$="1" then
  275.                 print "Inches";
  276.         else
  277.                 print "Centimetres";
  278.         end if
  279.         locate 17,35,1 : input "",dd$$
  280.         dd=val(dd$)
  281.         call printat(19,22,"Enter Parasitic Elemeent Diameter",0)
  282.         locate 20,32,0 : print "in ";
  283.         if p$="1" then
  284.                 print "Inches";
  285.         else
  286.                 print "Centimetres";
  287.         end if
  288.         locate 22,35,1 : input "",ed$
  289.         ed=val(ed$)
  290.         if p$="1" then
  291.                 dd = dd / inch
  292.                 ed = ed / inch
  293.         end if
  294.         if p$="2" then
  295.                 dd = dd / cm
  296.                 ed = ed / cm
  297.         end if
  298. wend
  299.  
  300. ' ********** MATHS ***********
  301. L1180:
  302. m=0 : sy=1
  303. sr=0.216144
  304. L1200:
  305. la=bl-sr
  306. for n=1 to 14
  307.         s(n)=0.081444+0.12178*log(n)
  308.         if n=1 then
  309.                 t(n)=sr+s(n)
  310.         else
  311.                 t(n)=t(n-1)+s(n)
  312.         end if
  313.         la=la-s(n)
  314.         if la < 0 then
  315.                 m=n-1 : n=14 : sy=la : la=la+s(n)
  316.         end if
  317. next n
  318. if sy < 0 then goto L1330:
  319. for n=15 to maxels
  320.         s(n)=s(14)
  321.         t(n)=t(n-1)+s(n)
  322.         la=la-s(n)
  323.         if la < 0 then
  324.                 m=n-1 : la=la+s(n) : n=maxels
  325.         end if
  326. next n
  327. L1330:
  328. ll=bl-la
  329. g1=9.2+3.39*log(ll)
  330. if g1<11.8 then
  331.         bl=1.05*bl
  332. lse
  333.         goto L1380
  334. end if
  335. goto L1200
  336. L1380:
  337. restore
  338. for q=1 to 7
  339.         read k,k1,k2,k3,k4
  340.         if k = ed then
  341.                 j=0 : goto L1480
  342.         end if
  343.         if k < ed then
  344.                 l=k
  345.         else
  346.                 goto L1430
  347.         end if
  348.         kl1=k1 : kl2=k2 : kl3=k3 : kl4=k4
  349. L1430:
  350.         if k > ed then
  351.                 h=k
  352.         else
  353.               goto L1460
  354.         end if
  355.         kh1=k1 : kh2=k2 : kh3=k3 : kh4=k4
  356.         goto L1470
  357. L1460:
  358. next q
  359. L1470:
  360. j=(ed-l)/(h-l)
  361. L1480:
  362. r=0.476945+bc
  363. de=(0.4777-(1.0522*dd)+(0.43363*(dd^-0.014891)))/2
  364. for n=1 to m
  365.         if j=0 then
  366.                 d(n)=(k1-k2*log(n))*(1-k3*exp(-k4*n))
  367.         else
  368.                 gosub L2040
  369.         end if
  370.         d(n)=d(n)+bc
  371. next n
  372.  
  373. ' ********* SCREEN DISPLAY ***********
  374. L2500:
  375. cls
  376. if len(sign$) then
  377.         call printat(1,20,"     DL6WU YAGI DESIGN FOR ",0)
  378.         print sign$;
  379. else
  380.         call printat(1,20,"---- DL6WU YAGI DESIGN DETAILS ----",0)
  381. end if
  382. call printat(33,20,"Design Frequency      :  ",0) : print freq$;" MHz";
  383. call printat(4,20,"Number of Elements    :  ",0) : print m+2;
  384. call printat(5,20,"Boom Diameter         :  ",0)
  385. xx=FNunits(bd)
  386. print using "###.###";xx; : printunits
  387.  
  388. end 3/5
  389.  
  390.  
  391.  
  392. Msg# 113934   To: ATARI @EU   From: ON4ASX   Date: 01Mar91/0641
  393. Subject: YAGI BAS 4/5
  394. Bulletin ID: 4690_ON4ASX
  395. Path: DB0CZ!DB0FRB!DB0GE!LX0PAC!ON7RC!ON4HU!ON4ASX
  396. From: ON4ASX@ON4ASX.BVWV.BEL.EU
  397. To  : ATARI@EU
  398.  
  399. 4/5
  400.  
  401. call printat(6,20,"Element Diameters",0)
  402. call printat(7,20,"        Driven        :  ",0)
  403. xx=FNunits(dd)
  404. print using "###.###";xx; : printunits
  405.  
  406. call printat(8,20,"        Parasitic     :  ",0)
  407. xx=FNunits(ed)
  408. print using "###.###";xx; : printunits
  409.  
  410. call printat(9,20,"Electrical Boom Length:  ",0)
  411. xx=FNunits(ll)
  412. print using "###.###";xx; : printunits
  413.  
  414. call printat(10,20,"Estimated Performance",0)
  415. call printat(11,20,"         Gain         :  ",0)
  416. print using "###.###";g1; : print " dBd";
  417. bh=30-3.14*(g1-14)
  418. call printat(12,20,"         E-Beamwidth  :  ",0)
  419. print using "###.###"; bh; : print " deg";
  420. bv=bh/cos(bh/(2*57))
  421. call printat(13,20,"         H-Beamwidth  :  ",0)
  422. print using "###.###"; bv; : print "" deg";
  423.  
  424. call printat(14,20,"Stacking Distances",0)
  425. call printat(15,20,"         Horizontal   :  ",0)
  426. sh=51/bh : sv=51/bv
  427. xx=FNunits(sh)
  428. print using "###.###";xx; : printunits
  429. call printat(16,20,"         Vertical     :  ",0)
  430. xx=FNunits(sv)
  431. print using "###.###"; xx; : printunits
  432.  
  433. locate 18,1,0
  434. print tab(10);"NOTES:"
  435. if len(bcor$) then
  436.         print tab(10);"You have chosen your own element mounting method"
  437.         print tab(10);"or boom correction"
  438.         goto L2770
  439. end if
  440. select case e$
  441.         case = "1"
  442.         print tab(10);"Elements are SECURELY connected to the metal boom"
  443.         case = "2"
  444.         print tab(10);"Ele
  445. ments are INSULATED through the metal boom"
  446.         case = "3"
  447.         print tab(10);"Elements are INSULATED or the boom is NON-CONDUCTIVE"
  448. end select
  449. L2770:
  450. if e$<>"3" then
  451.         print tab(10);"A boom correction of ";
  452.         print using "#.####"; bc1;
  453.         print " the boom diameter has been applied"
  454. end if
  455. print tab(10);"Tolerance required for element lengths is +/- ";
  456. xx=FNunits(0.003)
  457. print using "#.####"; xx; : printunits
  458.  
  459. print : print : print tab(20);"Hard Copy of Detailed Antenna Design? Y/N"
  460. do
  461.         kb$=ucase$(inkey$)
  462. loop until kb$="Y" or kb$="N"
  463. if kb$ = "Y" then goto HARDCOPY
  464.  
  465. AGAIN:
  466. print : print tab(35);"Run Again? Y/N";
  467. do
  468.         kb$=ucase$(inkey$)
  469. loop until kb$="Y" or kb$="N"
  470. if kb$ = "Y" then 
  471.         goto BEGIN
  472. else 
  473.         system
  474. end if
  475.  
  476.  
  477. ' ********** PRINTER OUTPUT ************
  478. HARDCOPY:
  479. if len(sign$) then
  480.        lprint tab(10);"DL6WU  YAGI DESIGN FOR ";sign$
  481.  
  482.         lprint tab(10);
  483.         for i=1 to len(sign$)
  484.                 lprint "=";
  485.         next i
  486.         lprint "======================"
  487. else
  488. lprint tab(10);"    DL6WU YAGI DESIGN DETAILS"
  489. lprint tab(10);"================================="
  490. end if
  491. lprint 
  492. lprint tab(10);"Original program by KY4Z and W6NBI"
  493. lprint tab(10);"Ported  t  the Atari ST  by G6ATW"
  494. lprint tab(10);"          ST Version 1.0"
  495. lprint : lprint
  496. lprint tab(10);"Design Frequency      :  "; freq$;" MHz"
  497. lprint tab(10);"Number of Elements    :  "; m+2
  498. lprint tab(10);"Boom Diameter         :  ";
  499. xx=FNunits(bd)
  500. lprint using "###.###";xx; : lprintunits
  501.  
  502. lprint tab(10);"Element Diameters";
  503. lprint tab(10)"        Driven        :  ";
  504. xx=FNunits(dd)
  505. lprint using "###.###";xx; : lprintunits
  506.  
  507. lprint tab(10);"        Parasitic     :  ";
  508. xx=FNunits(ed)
  509. lprint using "###.###";xx; : lprintunits
  510.  
  511. lprint tab(10);"Electrical Boom Length:  ";
  512. xx=FNunits(ll)
  513. lprint using "###.###";xx; : lprintunits
  514. lprint
  515. lprint tab(10);"Estimated Performance"
  516. lprint tab(10);"         Gain         :  ";
  517. lprint using "###.###";g1; : lprint " dBd"
  518. bh=30-3.14*(g1-14)
  519. lprint tab(10);"         E-Beamwidth  :  ";
  520. lprint using "###.###"; bh; : lprint " deg"
  521. bv=bh/cos(bh/(2*57))
  522. lprint tab(10);"         H-Beamwidth  :  ";
  523. lprint using "###.###"; bv; : lprint " deg"
  524. lprint
  525. end 4/5
  526.  
  527.  
  528.  
  529. bbs> Msg# 113935   To: ATARI @EU   From: ON4ASX   Date: 01Mar91/0644
  530. Subject: YAGI BAS 5/5
  531. Bulletin ID: 4691_ON4ASX
  532. Path: DB0CZ!DB0FRB!DB0GE!LX0PAC!ON7RC!ON4HU!ON4ASX
  533. To  : ATARI@EU
  534.  
  535. 5/5lprnt tab(10);"Stacking Distances"
  536. lprint tab(10);"         Horizontal   :  ";
  537. sh=51/bh : sv=51/bv
  538. xx=FNunits(sh)
  539. lprint uing  "###.###";xx; : lprintunits
  540. lprint tab(10);"         Vertical     :  ";
  541. xx=FNunits(sv)
  542. lprint using "###.###"; xx; : lprintunits
  543.  
  544. lprint tab(10);"NOTES:"
  545. if len(bcor$) then
  546.         lprint tab(10);"You have chosen your own element mounting method"
  547.         lprint tab(10);"or boom correction"
  548.         goto P2770
  549. end if
  550. select case e$
  551.         case = "1"
  552.         lprint tab(10);"Elements are SECURELY connected to the metal boom"
  553.         case = "2"
  554.         lprint tab(10);"Elements are INSULATED through the metal boom"
  555.         case = "3"
  556.         lprint tab(10);"Elements are INSULATED or the boom is NON-CONDUCTIVE"
  557. end select
  558. P2770:
  559. if e$<>"3" then
  560.         lprint tab(10);"A boom correction of ";
  561.         lprint using "#.####"; bc1;
  562.         lprint " the boom diameter has been applied"
  563. end if
  564. lprint tab(10);"Tolerance required for element lengths is +/- ";
  565. xx=FNunits(0.003)
  566. lprint using "#.####"; xx; : lprintunits
  567.  
  568. lprint chr$(12)
  569. lprint tab(6);"CUMULATIVE";tab(58);"ELEMENT"
  570. lprint tab(6);"SPACING";tab(58);"LENGTH"
  571. lprint tab(6);"----------";tab(58);"-------"
  572. lprint tab(4);"Cms";tab(15);"Inches";tab(56);"Cms";tab(64);"Inches"
  573. lprint
  574. lprint tab(4);"0";tab(15);"0";
  575. lprint tab(23);"REFL ----------#----------   ";
  576. xx=r*cm : lprint using "####.##";xx;
  577. lprint tab(63); : xx=r*inch : lprint using "####.##";xx
  578. lprint tab(38);"#"
  579. lprint tab(2); : xx=sr*cm :lprint using "####.##";xx;
  580. lprint tab(13); : xx=sr*inch : lprint using "####.##";xx;
  581. lprint tab(23);"DR EL =========#=========    "; 
  582. xx=de*cm : lprint using "####.##";xx;
  583. lprint tab(63); : xx=de*inch : lprint using "####.##";xx
  584. for n=1 to m
  585. lprint tab(38);"#"
  586. lprint tab(2); : xx=t(n)*cm :lprint using "####.##";xx;
  587. lprint tab(13); : xx=t(n)*inch : lprint using "####.##";xx;
  588. lprint tab(23);"D";str$(n); : if n<10 then lprint " ";
  589. lprint "   --------#--------     ";
  590. xx=d(n)*cm : lprint using "####.##";xx;
  591. lprint tab(63); : xx=d(n)*inch : lprint using "####.##";xx
  592. next n
  593. goto AGAIN
  594.  
  595. system
  596.  
  597. L20040:
  598.         dl(n)=(kl1-kl2*log(n))*(1-kl3*exp(-kl4*n))
  599.         dh(n)=(kh1-kh2*log(n))*(1-kh3*exp(-kh4*n))
  600.         d(n)=dl(n)+j*(dh(n)-dl(n))
  601. return
  602.  
  603. data .001, .4711, .018, .08398, .965
  604. data .003, .462, .01941, .08543, .9697
  605. data .005, .4538, .02117, .0951, 1.007
  606. data .007, .4491, .02274, .08801, .9004
  607. data .01, .4421, .02396, .1027, 1.038
  608. data .015, .4358,.02558, .1149, 1.034
  609. data .02, .4268, .02614, .1112, 1.036
  610.  
  611. DEF FNunits(wl)
  612.         local wl
  613.         shared p$, inch, cm
  614.         if p$="1"tnFunits=wl*inch  
  615.         if p$="2" then FNunits=wl*cm
  616. END DEF
  617.  
  618. SUB printunits
  619.         shared p$
  620.         if p$="1" then print " Inches";
  621.         if p$="2" then print " Centimtres";
  622.         if p$="3" then print " Wavelengths";
  623. END SUB
  624.  
  625. SUB lprintunits
  626.         shared p$
  627.         if p$="1" then lprint " Inches"
  628.         if p$="2" then lprint " Centimetres"
  629.         if p$="3" then lprint " Wavelengths"
  630. END SUB
  631.         
  632. SUB printat(row,col,s$,curs)
  633.         local row,col,s$,curs
  634.         locate row,col,curs
  635.         print s$;
  636. END SUB
  637.  
  638. SUB revideo(rev)
  639.         local rev,junk
  640.         if rev then 
  641.                 junk=FNbconout%(2,27)
  642.                 junk=FNbconout%(2,asc("p"))
  643.         else 
  644.                 junk=FNbconout%(2,27)
  645.                 junk=FNbconout%(2,asc("q"))
  646.         end if
  647. END SUB
  648.  
  649. SUB clearit
  650.         local junk
  651.         locate 6,1,0
  652.        junk=FNbconout%(2,27)
  653.         junk=FNbconout%(2,asc("J"))
  654. END SUB
  655.         
  656. SUB dickhead
  657. END SUB
  658.  
  659.